00100	C*** 33 PARAMS SEEMS TO BE LIMIT IN THIS VERSION. (30 IN 'SCORE') *****
00200		SUBROUTINE TRANS(JJJ)
00300		COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
00400		DIMENSION NN(100)
00500	C  W(35) FOR PARAMETERS
00600	C  THE 'ROUT' COMMON BLOCK IS 1ST OUTPUT BLOCK IN 'PASS3'.
00700	      COMMON /ROUT/I(200) ,RX(80),JX(80)  /TR/LX(12),K
00800	     1,INSNUM(27),P(30),NPAR(27),JSEM,IPRNT,IPP
00900	     1,SRATE,RNCHN,RMAG,INUM,INS,MM,M,N,JJ,X,Y,IK
01000	     1,ENDX,J  /KNAM/IPLAY,JFLNM  /IFIRST/IFIRST,IDT
01100		1 /INST/INST(27)
01200		1 /WDZ/WDZ(14),JWD(12) 
01300	      COMMON /SBFILN/SBFILN /AR/IOP /IGEN/IGEN /JP/JPRNT
01400	      COMMON LL  /P/W(1)  /CONV/ICONV /FQDR/FQDR(28,27),INSN
01500	      INTEGER FQDR
01600	C****************CHECK NEAR HERE FOR NEEDED CHANGES **************
01700	   	INTEGER*4 IDBL,JANP,JBLA,JFLNM,JDBG,
01800	   	1 INST,INAM,JSEMI,ICOLON
01900	      EQUIVALENCE (LESS,LX(9)),(IX,IXJ,JX),(RX2,RX(3)),
02000	     1(P2,P(2)),(RX3,RX(5)),(I3,I(3)),(ISEMI,LX(2))
02100	     1,(IBLA,LX(1)),(IAST,LX(3)),(IINS,INST),(IEQUAL,LX(8))
02200	     1,(IAROW,LX(7)),(W1,W),(W3,W(3)),(W2,W(2))
02300	
02400	      DATA LX/' ',';', '*','/','-','+','←','=','<' ,',' ,'(', ')'/,
02500	     1  IDOT/'.'/, IDEV/1/,JPRNT/1/,JFLNM/'TRNS'/,N0/'0'/,N9/'9'/
02600		1,JBLA/'    '/,JDBG/'#   '/,JPERC/'%   '/,JSEMI/';   '/
02700	C*** THIS VERSION STARTS OUT WITH DEFAULT OUTPUT TO FILE: TRNS.DAT
02800	      DATA RMAG/.0512/,INUM/0/,SRATE/12800./,RNCHN/1./,JQUOT/'"    '/
02900		1,JEXP/'!   '/,JANP/'&   '/,ICONV/-1/,JCOLON/':   '/
03000	C ICONV=-1 MEANS WRITE A SOUND FILE. (=0 = WRITE A FILE FOR 'SMPLS' PROG.)
03100	
03200		GO TO (555,500) JJJ
03300	555      IF(IFIRST)404,  5,5  
03400	404      IGEN=-1
03500		KA=1
03600	C KA IS POINTER TO INPUT ARRAY
03700		IF(INUM.NE.0)GO TO 30
03800		DO 411 K=1,27 
03900	411	INST(K)=0
04000	CIN	DO 411 K=1,108
04100	CIN411	IINS(K)=0
04200	C ZERO OUT INSTR. NAME ARRAY.
04300	30    IPLAY=0
04400	      ENDX=0
04500		KK=0
04600	      JSEM=0
04700	      INS=-1
04800	402      IDEV=1
04900	412      WRITE(JTYPE,1)
05000	1	 FORMAT(' INPUT? '$)
05100	100      FORMAT(' >'$)
05200	2      FORMAT(A4)
05300		READ(JTYPE,2)IDBL
05400	C IDBL WILL HAVE TO BE DOUBLE PREC. ON PDP11 ************
05500	      IF(IDBL.NE.JBLA)GO TO 400
05600	      IDEV=5
05700	      GO TO 5
05800	400      IF(IDBL.NE.JANP)GO TO 602    
05900		JPRNT=-JPRNT
06000		GO TO 412
06100	C!*** & IS PRNT-NOPRNT FLIPFLOP
06200	602      IF(IDBL.NE.JQUOT)GO TO 408
06300	C!*** " FOR INSTRUMENT LIST.
06400	      DO 606 K=1,INUM
06500		JK=INSNUM(K)
06600		MM=NPAR(JK)-2
06700	606      WRITE(JTYPE,607)INST(K),JK,MM
06800	      GO TO 402
06900	607      FORMAT(1X,A4,'  INS#',I2,'  PARAMS=',I2)      
07000	C!*** PRINTS INST INFO.
07100	408	IF(IDBL.NE.JEXP)GO TO 603
07200	C TRIGGERS ICONV FLIPFLOP
07300		IF(ICONV.LT.0)GO TO 2408
07400		ICONV=-1
07500		WRITE(JTYPE, 3408)
07600		GO TO 412
07700	2408	ICONV=0
07800		WRITE(JTYPE, 4408)
07900		GO TO 412
08000	3408	FORMAT(' OUTPUT=TEST.SND'/)
08100	4408	FORMAT(' OUTPUT=TEST.DAT'/)
08200	603	IF(IDBL.EQ.JPERC)CALL PLAY
08300	C TYPE % TO RE-PLAY SOUND
08400	2326	FORMAT(1X100A1)
08500	410	IF(IDBL.EQ.JCOLON)CALL EXIT
08600	C TYPE ':' TO EXIT AND CLOSE ALL FILES.
08700	C11******************************************???????????????????
08800		CALL CLOSIT(IDEV)
08900	CCCC	CALL CLOSE(IDEV)
09000	C11******************************************???????????????????
09100		CALL DISKO(IDEV,IDBL,3)
09200	C                        3=OPEN FORMATTED INPUT FILE.
09300	4      FORMAT(100A1)
09400	
09500	5     IF(KA.NE.1)GO TO 521
09600	502      IF(IDEV.NE.5)GO TO 601
09700	C*******************************
09800	      IF(IGEN.NE.2)IGEN=-1
09900	503      WRITE(JTYPE, 100)
10000	C*******************************
10100	601	KA=1
10200		READ(IDEV,4,END=404)NN
10300	121	DO 421 LEND=100,1,-1
10400	C FIND LAST CHAR. IN LINE
10500	421	IF(NN(LEND).NE.IBLA)GO TO 621
10600	C NOW WE'VE FOUND A BLANK LINE
10700		IF(IDEV.EQ.1)GO TO 601
10800		GO TO 402
10900	621	IF(IDEV.EQ.5)GO TO 521 
11000		IF(JPRNT.LT.0)WRITE(JTYPE, 2326)(NN(IJI),IJI=1,LEND)
11100	521	IF(KK.EQ.0)JA=0
11200	C KK IS FLAG FOR CONTINUATION LINES.
11300		DO 21 LSEM=KA,LEND
11400		LS=NN(LSEM)
11500		IF(LS.NE.LESS)GO TO 21
11600		KK=0
11700		GO TO 601
11800	21	IF(LS.EQ.ISEMI)GO TO 821
11900	C SET FLAG TO LOOP BACK TO READ ANOTHER LINE
12000		KK=-1
12100		GO TO 721
12200	
12300	821	KK=0
12400	C SET KK TO 0 EVERY TIME WE HIT A SEMICOLON
12500	221	IF(LSEM.EQ.1)GO TO 721
12600		KB=LSEM-1
12700		IF(NN(KB).NE.IBLA)GO TO 721
12800	C DELETE BLANKS BEFORE A SEMICOLON
12900		NN(KB)=ISEMI
13000		NN(LSEM)=IBLA
13100		IF(LEND.EQ.LSEM)LEND=LEND-1
13200		LSEM=LSEM-1
13300		GO TO 221
13400	721	IF(JA.EQ.0)GO TO 921
13500		JA=JA+1
13600		I(JA)=IBLA
13700	C INSERT A BLANK IF A CONTINUATION LINE.
13800	921   	KC=IBLA
13900	C LEADING BLANKS AND MULTIPLE BLANKS ARE DELETED.
14000		DO 321 KB=KA,LSEM
14100	C LSEM IS CHAR COUNT IN I ARRAY NOW (LOCATES THE SEMI COLON)
14200		K=NN(KB)
14300		IF(K.NE.IBLA)GO TO 1021
14400		IF(KC.EQ.IBLA)GO TO 321
14500	C DELETE STRINGS OF BLANKS
14600	1021	JA=JA+1
14700		I(JA)=K
14800		KC=K
14900	321	CONTINUE
15000	C CURRENTLY CAN STORE 200 CHARS. IN I ARRAY. (ENOUGH FOR 30 PARAMS?)
15100		KA=LSEM+1
15200		IF(KA.GT.LEND)KA=1
15300		IF(KK.NE.0)GO TO 502
15400	C GO READ MORE IF NO SEMICOLON WAS FOUND.
15500		IF(I(1).EQ.ISEMI)GO TO 5
15600	C CATCHES DUPLICATE SEMICOLON
15700	1408      DO 407 K=1,80 
15800	407      JX(K)=IBLA
15900	406      MM=0
16000	C INIT VARIOUS THINGS
16100		DO 4061 J=2,80,2
16200	4061	RX(J)=0
16300	        J=-1      
16400	      IPRNT=0
16500	119      JI=0
16600	9      M=0
16700		N=JI+1
16800	6      JI=JI+1
16900		   KCHAR=I(JI)
17000	      DO 7 L=1,12
17100	7      IF(KCHAR.EQ.LX(L))GO TO 8
17200	C JUMP OUT IF PUNCT., SPACE, SEMI., ETC.
17300	      M=M+1
17400	      GO TO 6            
17500	C!**** NO STRING CAN EXCEED 10 CHARS.
17600	8       IF(M.EQ.0)GO TO 140
17700	      IF(M.GT.10)M=10
17800	      MM=MM+1
17900	      IF(MM.LE.40)GO TO 88
18000	      WRITE(JTYPE, 888)(I(JJ),JJ=N,N+9)
18100	      STOP
18200	888      FORMAT(' LINE TOO LONG -- ',10A1)
18300	88      JJ=I(N)
18400		IF(JJ.GT.N9)GO TO 16  
18500		IF(JJ.NE.IDOT.AND.JJ.LT.N0)GO TO 16
18600	C**** 8240='0'  8249='9'
18700	C!***** JUMP IF 1ST CHAR. IS A LETTER.
18800		Y=0
18900	      DOT=10.
19000	      DO 18 JK=N,N+M-1
19100	      KB=I(JK)
19200	      IF(KB.NE.IDOT)GO TO 17
19300	      DOT=.1
19400	      GO TO 18
19500	17    X=NASCI(KB)                 
19600	C!**** CHANGE ASCII INTO NUMBER
19700	      IF(DOT.LT.1)GO TO 19
19800	      Y=Y*DOT+X
19900	      GO TO 18
20000	19      Y=Y+X*DOT
20100	      DOT=DOT/10.
20200	18      CONTINUE
20300		IF(IGEN.EQ.2)Y=Y*100+1000.
20400	C ABOVE PUTS CONSTANTS IN INS DEFINITIONS. PLUS ONLY. LIMIT??
20500	      RX(MM*2-1)=Y
20600	      RX(MM*2)=-9999.0
20700	      GO TO 140
20800	
20900	16	JK=MM*2-1
21000	        CALL MPACK(M,I(N),JX(JK),N)
21100	C N=CURRENT POINTER TO I ARRAY - USED LATER TO LOCATE INST. NAMES.
21200		IJ=JX(JK)
21300		IF(IJ.GE.0)GO TO 144
21400	C IF IJ < 0, THEN IT'S A LETTER
21500		JX(MM*2)=M
21600	C SAVE THE WD CNT OF POTENTIAL INST. NAME.
21700		GO TO 143
21800	144	IF(IJ.NE.408)GO TO 140
21900	C "WORD" TYPES OUT RESERVED WORD LIST
22000		WRITE(JTYPE, 244)WDZ,JWD
22100		WRITE(JTYPE, 245)
22200		GO TO 503
22300	244	FORMAT(15(1XA4))
22400	245	FORMAT(' %=REPLAY, &=SHOW INPUT, !=SOUND-SIGHT, "=
22500		1INSTS., :=EXIT, CLOSE FILES')
22600	140      IF(IJ.EQ.400)GO TO 5
22700	C  400='PLAY;' THIS CAN BE THROWN AWAY NOW.
22800	143	IF(KCHAR.EQ.IBLA)GO TO 10
22900	      IF(L.EQ.7)KCHAR=IEQUAL     
23000	141   MM=MM+1
23100		KI=MM*2-1
23200		JX(KI)=KCHAR
23300	10      IF(JI.EQ.JA)GO TO 15
23400	C  JA POINTS TO LAST CHAR. TO LOOK AT FOR NOW.
23500	1010	IF(I(JI+1).NE.IBLA)GO TO 11
23600	      JI=JI+1
23700	      GO TO 1010
23800	11	IF(JI.LT.JA)GO TO 9
23900	C NOW WE HAVE ALL ITEMS IN IX ARRAY
24000		IF(MM.GT.1)GO TO 15
24100	C CATCH 'WORD  ;' AT END OF LINE
24200		IF(M.EQ.0)GO TO 5
24300	15      MM=MM*2
24400	142      J=-1      
24500	      IF(INS.LT.0)GO TO 305
24600	      IF(INS.EQ.2)GO TO 305
24700	      MM=0
24800	      INS=-1    
24900	C!***** NOW INITIALIZATION COMPLETE
25000	      GO TO 5
25100	50      LL=LL-1
25200		IF(IGEN)308,309,309
25300	309   IF(IJ.EQ.12)IGEN=-1   
25400	C!*** FOUND 'END'
25500	      IF(IJ.NE.412)GO TO 59
25600	C JUMP IF NOT 'INS' LINE.
25700	  	IF(LL.NE.2)GO TO 59
25800	C IF WDCNT IS 2, DO THE NEXT
25900	  	LL=3
26000	C NOW YOU CAN HAVE 'INS 2;' INSTEAD OF 'INS 0 2;' ETC. (EITHER WAY!)
26100	  	W3=W2
26200	  	W2=0
26300		GO TO 59
26400	308      W1=1
26500		IK=W2
26600	      IF(LL.GT.NPAR(IK))GO TO 56
26700	54      IF(LL.LT.3)LL=3
26800	      DO 55 K=LL,NPAR(IK)
26900	55      W(K)=P(K-2)    
27000	C!***** GET INFO ALREADY IN PARAMS
27100	56      DO 57 K=3,LL
27200	57      P(K-2)=W(K)      
27300	C!**** FILL UP P LIST AGAIN
27400	      X=W3            
27500	C!*** EXCHANGE W2 AND W3, ACTION TIME, INST #
27600	      W3=W2
27700	      W2=X
27800	58      LL=NPAR(IK)
27850		TYPE *,LL,IK
27900	      DO 52 K=5,LL
28000		KI=FQDR(K-4,IK)
28100		IF(KI)53,52,2352
28200	2352      W(K)=RMAG/W(K)
28300	      GO TO 52
28400	53      W(K)=RMAG*W(K)
28500	52      CONTINUE
28600	      IF(ENDX.LT.W2+P2)ENDX=W2+P2
28700	59       IF(W1.NE.2.)GO TO 592
28800		IF(LL.EQ.2)GO TO 597
28900	C JUMP IF 'END' OF INS DEF.
29000		IF(LL.NE.3)GO TO 595
29100	C  JUMP IF NOT AN INST DEF.
29200		PSV=0
29300		SV=35
29400	C EXPLAIN USE OF STORAGE PARAMS!!
29500		INSN=W3
29600	C  INS DEF NUM.
29650		TYPE *,INSN
29700		DO 586 K=1,28
29800	C CLEAR FREQ-DUR FLAGS FOR THIS INST.
29900	586	FQDR(K,INSN)=0
30000	C LIST OF INST NAMES MUST FOLLOW 'INS N;'  !!!ALWAYS!!!
30100	596	READ(IDEV,2,END=587)INAM
30200		IF(INAM.EQ.JSEMI)GO TO 592
30300	C LIST OF INST NAMES TERMINATES WITH ';'.
30400		DO 588 K=1,INUM
30500		IF(INAM.NE.INST(K))GO TO 588
30600		INST(K)=INAM
30700		INSNUM(K)=INSN
30800		GO TO 589
30900	587	PAUSE 'MISSING SEMICOLON'
31000	588	CONTINUE
31100		INUM=INUM+1
31200		INST(INUM)=INAM
31300	C LIST OF INST NAMES TERMINATES WITH ';'.
31400		INSNUM(INUM)=INSN
31500	589	IF(JPRNT.LT.0)WRITE(JTYPE, 244)INAM
31600		GO TO 596
31700	
31800	595	DO 593 K=3,LL
31900		X=W(K)
32000		IF(X.LT.0.OR.X.GT.100)GO TO 593
32100		IF(X.GT.PSV)PSV=X
32200	C CHECK FOR OVERLAPPING PARAM NUMS.
32300	593	CONTINUE
32400		 IF(W3.NE.102.AND.W3.NE.105.AND.W3.NE.111.AND.W3.NE.104
32500		1 .AND.W3.NE.115)GO TO 592
32600	C 115=NOS, 102=OSC, 105=ENV, 104=RAI (3 STOR. LOCS), 111=RAH (2 STOR. LOCS)
32700	C NEXT SETS UP STORAGE LOCATIONS FOR OSC, ENV, RAN, AND RAH.
32800		X=W3
32900	594	LL=LL+1
33000		W(LL)=SV
33100		SV=SV-1
33200	C DECREMENT THE HIGH PARAM NUM.
33300		IF(SV.LT.PSV)PAUSE 'PARAMETER OVERLAP'
33400	CIN	IF(SV.LT.PSV)CALL ERROR(5)
33500	C  IF STORAGE PARAM NUM. OVERLAPS WITH INSTS/'S PARAMS = ERROR
33600		IF(X.NE.111.AND.X.NE.104)GO TO 592
33700		IF(X.EQ.111)X=0
33800		IF(X.EQ.104)X=111
33900		GO TO 594
34000	
34100	597	NPAR(INSN)=PSV
34200	C SAVE THE HIGHEST PARAM NUM.
34300	
34400	592	IF(JPRNT.GE.0)GO TO 591
34500	      WRITE(JTYPE, 51)LL,(W(K),K=1,LL)
34600	C ABOVE WRITES ONTO FILE 'D.DAT' *** TEMPORARY FOR DEBUGGING.
34700	591      IDT=2
34800		RETURN
34900	
35000	500      IFIRST=0
35100	      IF(IGEN.EQ.0)IGEN=-1
35200	      IF(W1.NE.6)GO TO 555
35300	      RETURN
35400	C  W1=6 = 'FINISH;'  [W ARRAY IS EQUIV. TO P ARRAY IN MUSIC5]
35500	
35600	306      IF(JPRNT.LT.0)WRITE(JTYPE, 1307)(W(K),K=1,LL-1)
35700		      IF(JPRNT.GT.0)WRITE(JTYPE, 307)(W(K),K=1,LL-1)
35800	      IPRNT=0                  
35900	C!** RESET NO-PRNT FLAG
36000	      INS=-1
36100		GO TO 5
36200	C!** GO READ ANOTHER LINE
36300	305	CALL MSCAN
36400		IF(IJ.EQ.401)GO TO 500
36500	C 401=FINISH WAS FOUND.
36600		IF(IPRNT.LT.0)GO TO 306
36700		IF(JSEM.EQ.0)GO TO 5
36800		GO TO 50
36900	51      FORMAT(I3,35F10.3/)
37000	307      FORMAT('+',F8.2,$)
37100	1307      FORMAT(F10.3)
37200	      END
37300	
37400		FUNCTION NASCI(N)
37500	CPDP10	DATA IEX/536870912/,IZERO/'0'/
37600	C THIS BIG NUMBER MUST BE CHANGED ON PDP11***************
37700	CPDP10	NASCI=(N-IZERO)/IEX
37800	C CONVERTS SINGLE ASCII CHARACTER TO INTEGER.
37900	   	NASCI=N-8240
38000	C  THIS FORM FOR PDP11
38100		END
38200